home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE19 / CLINIC / FILELSTU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-10-23  |  1.5 KB  |  68 lines
  1. unit Filelstu;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinTypes, WinProcs, SysUtils, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Memo1: TMemo;
  12.     procedure Memo1DblClick(Sender: TObject);
  13.   private
  14.     { Private declarations }
  15.   public
  16.     procedure MyCallBack(const Directory: String);
  17.   end;
  18.  
  19.   TCallBack = procedure(const Directory: String) of object;
  20.  
  21. var
  22.   Form1: TForm1;
  23.  
  24. implementation
  25.  
  26. {$R *.DFM}
  27.  
  28. procedure TForm1.MyCallBack(const Directory: String);
  29. begin
  30.   Memo1.Lines.Add(Directory);
  31.   Caption := IntToStr(Memo1.Lines.Count);
  32.   Application.ProcessMessages;
  33. end;
  34.  
  35. procedure GetSubDirs(const Dir: String; CallBack: TCallBack);
  36. var
  37.   SearchRec: TSearchRec;
  38.   ThisDir: String;
  39. begin
  40.   if FindFirst(Dir + '\*.*', faDirectory, SearchRec) = 0 then
  41.     try
  42.       repeat
  43.            { Only want directories }
  44.         if (SearchRec.Attr and faDirectory <> 0) and
  45.            { Don't want current or parent directory }
  46.            (SearchRec.Name[1] <> '.') then
  47.           begin
  48.             ThisDir := Dir + '\' + SearchRec.Name;
  49.             if Assigned(CallBack) then
  50.               CallBack(ThisDir);
  51.             GetSubDirs(ThisDir, CallBack);
  52.           end;
  53.       until (FindNext(SearchRec) <> 0) or Application.Terminated;
  54.     finally
  55.       FindClose(SearchRec);
  56.     end;
  57. end;
  58.  
  59. procedure TForm1.Memo1DblClick(Sender: TObject);
  60. begin
  61.   Memo1.Lines.Clear;
  62.   Memo1.Lines.BeginUpdate;
  63.   GetSubDirs('c:', MyCallBack);
  64.   Memo1.Lines.EndUpdate;
  65. end;
  66.  
  67. end.
  68.